home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-04 / memos.zip / MEMORW.PRG < prev    next >
Text File  |  1993-03-10  |  5KB  |  187 lines
  1. /****
  2. *   Program Name: MEMORW.PRG 
  3. *
  4. *   Date Created: 03/10/93          
  5. *   Time Created: 13:29:52
  6. *   Author      : Michael Abadjiev
  7. *   Language    : Clipper 5.0    
  8. *   Compile     : clipper MEMORW.PRG /n /w /dTEST
  9. *
  10. *   -=- NOTE:   Replacement of MemoRead() and MemoWrit()
  11. */
  12.  
  13. #include "box.ch"
  14.  
  15. /*---------------------- Test Module --------------------------------------*/
  16. //#define TEST
  17. #ifdef TEST
  18.  
  19. FUNCTION TestModule()
  20.  
  21.     LOCAL cBuffer := "",                            ;
  22.           i,j,                                      ;
  23.           cScr := savescreen(0,0,maxrow(),maxcol())
  24.  
  25.     set cursor off
  26.     set scoreboard off
  27.     setcolor("W/B,W+/R")
  28.  
  29.     BEGIN SEQUENCE
  30.  
  31.     @ maxrow(),0 say padc("Wait",maxcol()+1) color "N*/W"
  32.     IF !file("_TEST_")
  33.         FOR j := 1 TO 120
  34.             FOR i := 65 TO 105
  35.                 cBuffer+= chr(i) 
  36.             NEXT
  37.         NEXT                 
  38.  
  39.         // Write to file
  40.         IF !memowrit("_Test_",cBuffer,.t.)
  41.             BREAK
  42.         ENDIF
  43.     ELSE
  44.         cBuffer := memoread("_TEST_",.t.)
  45.         IF len(cBuffer) == 0
  46.             BREAK
  47.         ENDIF
  48.     ENDIF                  
  49.     dispbegin()
  50.     dispbox(0,0,maxrow(),maxcol(),replicate("░",9),"N/W")
  51.     dispbox(0,0,maxrow(),maxcol(),B_SINGLE + " ","W/B")
  52.     @ 0,2 say " Replacement of Clipper functions: MemoRead(),MemoWrit() - " ;
  53.               color "GR+/B"
  54.     @ row(), col() say "More Control " color "GR+*/B"
  55.     @ maxrow(),2 say " Written by: Michael Abadjiev CIS: 71563,3312 " ;
  56.               color "GB+/B"
  57.     dispend()
  58.     set cursor on
  59.     cBuffer := MemoEdit( cBuffer,01,01,maxrow()-1,maxcol()-1,.t.)
  60.  
  61.     memowrit("_TEST_",cBuffer,.t.)
  62.  
  63.     END SEQUENCE
  64.  
  65.     restscreen(0,0,maxrow(),maxcol(),cScr)
  66.  
  67. RETURN nil
  68.  
  69. #endif
  70.  
  71. /*---------------------- End of Test Module -------------------------------*/
  72.  
  73.  
  74. /****
  75. *       Function: MemoRead(<cFile>,[<lDisplay>]) -->CHARACTER
  76. *       Purpose : Replacement of MemoRead() - more control
  77. *   Date Created: 03/10/93
  78. */
  79.  
  80. FUNCTION MemoRead(cFile, lDisplay)
  81.  
  82.    LOCAL nError, cResult := "", nSize, nHandle, nBytes
  83.  
  84.    lDisplay := IF(valtype(lDisplay) <> "L",.f.,lDisplay)
  85.  
  86.    BEGIN SEQUENCE
  87.  
  88.         IF valtype(cFile) <> "C"
  89.             alert("ERROR: Function MemoRead(cFile)!;"+GetDosErr(1000))
  90.             cResult := ""
  91.             BREAK
  92.         ENDIF
  93.  
  94.         nHandle := fopen(cFile)
  95.  
  96.         IF (nError := ferror()) <> 0
  97.             IF(lDisplay,alert("ERROR: " + GetDosErr(nError)),nil)
  98.             BREAK
  99.         ENDIF
  100.  
  101.         IF (nSize := FSize(cFile)) == 0 
  102.             IF(lDisplay,alert("ERROR: File: " + upper(cFile) + " just created!;"+;
  103.                     "Nothing to read!"),nil)
  104.             BREAK
  105.         ENDIF
  106.         IF nSize >= 64000
  107.             IF(lDisplay,alert("ERROR: File: " + upper(cFile) + " too big!;"+;
  108.                     "Clipper cannot hadle that file!"),nil)
  109.             BREAK
  110.         ENDIF
  111.         cResult := space(nSize)            
  112.         nBytes := len(cResult)
  113.         IF fread(nHandle,@cResult,nBytes) <> nBytes
  114.             cResult := "" 
  115.             IF(lDisplay,alert("ERROR: Reading file: " + upper(cFile)),nil)
  116.             BREAK
  117.         ENDIF
  118.  
  119.     END SEQUENCE
  120.  
  121.     IF(nError == 0,fclose(nHandle),nil)
  122.  
  123. RETURN cResult
  124.  
  125.  
  126. /****
  127. *       Function: MemoWrit(<cFile>,<cVar>,[<lDisplay>]) -->LOGICAL
  128. *       Purpose : Replacement of MemoWrit() - more control
  129. *   Date Created: 03/10/93
  130. */
  131.  
  132.  
  133. FUNCTION MemoWrit(cFile, cVar, lDisplay)
  134.  
  135.    LOCAL nError, lResult := .f., nSize, nHandle, nBytes
  136.  
  137.    lDisplay := IF(valtype(lDisplay) <> "L",.f.,lDisplay)
  138.  
  139.    BEGIN SEQUENCE
  140.  
  141.         IF valtype(cFile) <> "C"
  142.             alert("ERROR: Function MemoWrit(cFile)!;"+GetDosErr(1000))
  143.             BREAK
  144.         ENDIF
  145.  
  146.         IF valtype(cVar) <> "C"
  147.             alert("ERROR: Function MemoWrit(,cVar)!;"+GetDosErr(1000))
  148.             BREAK
  149.         ENDIF
  150.  
  151.         // File exist...
  152.         nHandle := fopen(cFile)
  153.  
  154.         IF (nError := ferror()) == 0
  155.             IF lDisplay
  156.                 IF  alert("WARNING: File:" + upper(cFile) + ;
  157.                     " Already exist!;" + "Overwrite file?",{"No","Yes"}) <> 2
  158.                     BREAK
  159.                 ENDIF
  160.             ENDIF
  161.         ENDIF
  162.  
  163.         IF(nError == 0,fclose(nHandle),nil)
  164.  
  165.         nHandle := fcreate(cFile)
  166.  
  167.         IF (nError := ferror()) <> 0
  168.             IF(lDisplay,alert("ERROR: " + GetDosErr(nError)),nil)
  169.             BREAK
  170.         ENDIF  
  171.  
  172.         // Just for speed considerations....
  173.         nBytes := len(cVar)
  174.         IF fwrite(nHandle,@cVar,nBytes) <> nBytes
  175.             IF(lDisplay,alert("ERROR: Reading file: " + upper(cFile)),nil)
  176.             BREAK
  177.         ENDIF
  178.  
  179.         // Finally evething is fine...
  180.         lResult := .t.
  181.  
  182.     END SEQUENCE
  183.  
  184.     IF(nError == 0,fclose(nHandle),nil)
  185.  
  186. RETURN lResult
  187.